COMMENT ⊗   VALID 00010 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	   CCLOAD 						  -*-LISP-*-
C00007 00003
C00016 00004
C00018 00005
C00021 00006
C00023 00007
C00026 00008
C00030 00009
C00032 00010
C00036 ENDMK
C⊗;
;;;   CCLOAD 						  -*-LISP-*-
;;;   **************************************************************
;;;   ***** Maclisp ****** CCLOAD - Loader for COMPLR **************
;;;   **************************************************************
;;;   ** (c) Copyright 1980 Massachusetts Institute of Technology **
;;;   ****** this is a read-only file! (all writes reserved) *******
;;;   **************************************************************

 (COMMENT CORE 80. BPS 23000.) (print 'Ncomplr)(sstatus features Ncomplr)
;(COMMENT core 80.)(print 'Bcomplr)(sstatus features Bcomplr)

;This will compose a MACLISP compiler from the following files:
;	   LISP;  BACKQ  FASL		(BACKQ.FAS on TOPS-10/20 systems)
;	   LISP;  DEFMAC FASL		(DEFMAC.FAS on TOPS-10/20 systems)
;	   LISP;  DEFMAX FASL		(DEFMAX.FAS on TOPS-10/20 systems)
;	   LISP;  MACAID FASL		(MACAID.FAS on TOPS-10/20 systems)
;	   LISP;  MLMAC FASL		(MLMAC.FAS on TOPS-10/20 systems)
;	   LISP;  GETMID FASL		(GETMID.FAS on TOPS-10/20 systems)
;          LISP;  LODBYT FASL           (LODBYT.FAS on TOPS-10/20 systems)
;          LISP;  SHARPM FASL           (SHARPM.FAS on TOPS-10/20 systems)
;	   LISP;  SETF	 FASL		(SETF.FAS on TOPS-10/20 systems)
;	   LISP;  LET    FASL		(LET.FAS on TOPS-10/20 systems, except
;					  for Stanford system where not used)
;          COMLAP;COMPLR FASL		(COMPLR.FAS on TOPS-10/20 systems)
;		  PHAS1  FASL		(PHAS1.FAS on TOPS-10/20 systems)
;		  COMAUX FASL		(COMAUX.FAS on TOPS-10/20 systems)
;		  INITIA FASL		(INITIA.FAS on TOPS-10/20 systems)
;		  MAKLAP FASL		(MAKLAP.FAS on TOPS-10/20 systems)
;		  FASLAP FASL		(FASLAP.FAS on TOPS-10/20 systems)
;Additionally, a gc-daemon and many other help files are loaded in the
;  SAIL version.
;Ordinarily, this file will be used as an "INIT" file, but it can be
;  directly loaded into a running lisp, using any of LOAD, or UREAD.

;Ordinarily the result will be :PDUMPI'd (by SUSPEND) as 
;   LSPDMP;CL.DMP <complrverno>  [there is a link on SYS for TS COMPLR
;				to LSPDMP;CL.DMP >]
; however, if (STATUS FEATURE EXPERIMENTAL) is non-null, then they
; will go out as LSPDMP;XC.DMP <complrverno>.  Thus there is a link 
; for XCOMPLR to LSPDMP;XC.DMP >


;;; Following code must come before everything else, so that only the 
;;;   important symbols get on the copy of the initial OBARRAY.
;;;   PURCOPYs the buckets of the initial OBARRAY copy.
;;; And even then, STRING doesn't want to be on it!


(macro CC:subload (x)
   (subst (cadr x) 'X '(OR (GET 'x 'VERSION) (FASLOAD (LISP) x))))

;;;; pure ATOM list for OBARRAY


   (PROG (N READTABLE *RSET)
	 (SETQ READTABLE (ARRAY () READTABLE 'T)
	       N (- (CADR (ARRAYDIMS 'OBARRAY)) 129.))
	 (COMMENT   ;Put on both obarrays
		   IGNORE COMPLRVERNO BITS PAIR CHARACTER TYPE-OF 
		   VECTORP STRINGP BITSP TYPECASEQ PTR-TYPEP *:TRUTH 
    ;		   MAKE-VECTOR VREF VSET VECTOR-LENGTH  
    ;		   BITS BIT RPLACBIT NIBBLE SET-NIBBLE 
    ;		   MAKE-STRING CHAR RPLACHAR CHAR-N RPLACHAR-N  
    ; 		   EXTEND SI:EXTENDP VECTOR STRING +INTERNAL-STRING-MARKER
    ;		   VERSION  PAIRP
		   +INTERNAL-TEMP-MARKER :LOCAL-VAR  CL:CL 
	           *EXPR *FEXPR *LEXPR **LEXPR @DEFINE ARRAY*  
		   CHOMP CHOMPHOOK CMSGFILES COBARRAY COMPILE COMPLR
		   STRUCT-LET  EVAL-ONCE  EVAL-ORDERED EVAL-ORDERED* 
		   GRIND-MACROEXPANDED  GENVALS  GENSYMS  
		   |DEFUN& MACRO|  |DEFUN&-CHECK-ARGS| |DEFUN&-ERROR| 
		   |MACRO MACRO|  |DEFMACRO MACRO|  |DEFMACRO-DISPLACE MACRO|
		   CERROR  FERROR  CERROR-PRINTER  ERROR-OUTPUT 
		   +INTERNAL-LOSSAGE 
		   COUTPUT  CREADTABLE  EOC-EVAL  EOF-COMPILE-QUEUE 
		   GENPREFIX  ALLOC-MARK-RATIO  GOFOO MACRO-EXPAND  MACROLIST 
		   MAKLAP  MSDEV  MSDIR  NCOMPLR  NO-EXTRA-OBARRAY  NOTYPE  
		   NUMFUN  NUMVAR  ONMLS  OWN-SYMBOL  RECOMPL  SKIP-WARNING 
		   SOBARRAY  SPECIAL  SPLITFILE  SPLITFILE-HOOK  SQUID 
		   SREADTABLE  SWITCHTABLE  TOPLEVEL  UNDFUNS  UNSPECIAL 
		   PRATTSTACK  USERATOMS-HOOKS  USER-STRING-MARK-IN-FASL
		   DEFSETF COMPUTE I-COMPUTE SIDE-EFFECTS RET-OK ACCESS INVERT
		   SETF  +INTERNAL-SETF-X  SETF-SIMPLEP-SCAN  STRUCT-SETF 
		   SSETF-COMPUTE SETF-COMPUTE  SSETF-I-COMPUTE SETF-I-COMPUTE 
		   SSETF-SIDE-EFFECTS  SETF-SIDE-EFFECTS  SSETF-RET-OK 
		   SETF-RET-OK  SSETF-ACCESS  SETF-ACCESS  SSETF-INVERT 
		   SETF-INVERT  SSETF-GENVALS  SETF-GENVALS  SSETF-GENSYMS 
		   SETF-GENSYMS  SSETF-USER-SLOT  SETF-USER-SLOT  SETF-STRUCT 
		   SETF-X  CONS-A-SETF  SETF-CLASS 
		   SETVST  USER-SLOT  QUERY-IO  Y-OR-N-P  YES-OR-NO-P )
	 (ALLOC '(FIXNUM (2048. 10240. .25) FLONUM (256. 4096. .10) 
		  BIGNUM (256. 4096. .10) SYMBOL (1536. 8192. .25) 
		  ARRAY (64. 1024. 64.) ))
	 (AND (STATUS FEATURE ITS) (ALLOC '(LIST (14336. 40960. .35))))
	 (SETQ *RSET () NOUUO () NORET 'T USERATOMS-HOOKS () ) 
	 (SETQ CCLOAD:PUTPROP PUTPROP)
	 (cond 
	   ((status feature SHARABLE) (setq PUTPROP PURE-PUTPROP))
	   ('T 
	     (setq PUTPROP 
		   (purcopy 
		     (append '(SELECTOR CONSTRUCTOR STRUCT=INFO VERSION 
			       GRINDFN GRINDPREDICT CARCDR |side-effectsp/|| 
			       EXPR FEXPR MACRO AUTOLOAD SETF-X GRINDFN 
			       GRINDPREDICT GRINDMACRO GRINDFLATSIZE)  
			     PUTPROP))
		   PURE-PUTPROP PUTPROP)))
	 (SETQ PUTPROP (APPEND '(STATUS SSTATUS INST INSTN IMMED CARCDR ARITHP 
				 NUMBERP NOTNUMP CONTAGIOUS COMMU BOTH CONV 
				 ACS MINUS FLOATI P1BOOL1ABLE FUNTYP-INFO ARGS)
 			       PUTPROP))
	  ;; THESE ARE "BOOTSTRAP" VERSIONS - WILL BE REDEFINED BY MAKLAP FILE
	 (DEFUN SPECIAL MACRO (L) 
		(MAPC #'(LAMBDA (X) (PUTPROP X (LIST 'SPECIAL X) 'SPECIAL))
		      (CDR L))
		''SPECIAL)
	 (DEFUN *LEXPR MACRO (L) 
		(MAPC #'(LAMBDA (X) (PUTPROP X 'T '*LEXPR))
		      (CDR L))
		''*LEXPR)
	 (DEFUN *EXPR MACRO (L) 
		(MAPC #'(LAMBDA (X) (PUTPROP X 'T '*EXPR))
		      (CDR L))
		''*EXPR)
	 (SETQ CCLOAD:BOOTMACS '(SPECIAL *EXPR *LEXPR))
  #-SAIL (SSTATUS FEATURE COMPLR) 
  #+ITS	 (SETQ CCLOAD:DUMPFILE () CCLOAD:DUMPVERNO '/0)
	 (SETQ CCLOAD:PURE PURE 
	       *PURE 'T 
	       PURE (COND ((STATUS FEATURE PAGING) 
			   (setq ccload:pureseg ())
			   (setq *pure ())
			   1)
			  ('T #-SAIL -1 
			      #+SAIL
			        (COND ((STATUS FEATURE NCOMPLR) 
				       (SETQ CCLOAD:PURESEG T) -1)
				      ((STATUS FEATURE BCOMPLR) 
				       (SETQ CCLOAD:PURESEG ()) 1)
				      ('T (TERPRI) (PRINT 'PURE) (PRINT '| |) 
					  (PRINT '=) (PRINT '| |)  (PRINT '?)
					  (TERPRI) (BREAK NCOMPLR))) )))
	 (CC:subload DEFMAX)
	 (CC:subload MACAID)
;	 (load '(EXTSTR lsp))
 	 (CC:subload EXTSTR)
	 (CC:subload EXTHUK)
	 (CC:subload ERRCK)
	 (CC:subload MLMAC)
	 (OR (FBOUNDP (CAR (STATUS MACRO /#)))
	     (CC:subload SHARPM))
	 (OR (FBOUNDP (CAR (STATUS MACRO /`)))
	     (CC:subload BACKQ))
  #+SAIL (SSTATUS FEATURE COMPLR) 
	 (REMOB 'CC:subload)
	 (SETQ SAIL-MORE-SYSFUNS () )
  #+SAIL (FASLOAD (DSK (MAC LSP)) MATCH FAS)
; #+SAIL (FASLOAD (DSK (MAC LSP)) STRING FAS)
	 (AND (STATUS FEATURE EXPERIMENTAL) 
	      (NOT (STATUS FEATURE XC))
	      (SSTATUS FEATURE XC))
	 (SETQ CCLOAD:INITIAL-MACROS '(LOAD-BYTE DEPOSIT-BYTE LDB DPB SETF) )
	 (MAPATOMS '(LAMBDA (X) (AND (GET X 'MACRO) 
				     (PUSH X CCLOAD:INITIAL-MACROS))))
	 (SSTATUS FEATURE NOLDMSG)
	 (SETQ IREADTABLE READTABLE)
	 (SETQ IOBARRAY (ARRAY () OBARRAY '() ))	;Make pure copy of 
	 (DO I 0 (1+ I) (= I N) 			; original obarray
	     (STORE (ARRAYCALL T IOBARRAY I) (PURCOPY (OBARRAY I))))
   #+ITS (COND ((STATUS FEATURE SHARABLE) 
		(MAPC 'DEPURIFY-SYMBOL DEPURIFY-SYMBOL)
		(MAPC '(LAMBDA (X) 
			 (MAPC 'DEPURIFY-SYMBOL (APPEND (CAR X) (CDR X))))
		      *SHARING-FILE-LIST*)
		(MAPC 'DEPURIFY-SYMBOL (CONS (STATUS UDIR)
					     '(AI ML MC DSK LSPDMP LISP)))))
	 (RETURN '*))


;;;; PROGN for LOAD of files


(PROGN 
  (PROG (GL LVRL TIME RUNTIME PUTPROP ALARMCLOCK SLOTX REGACS 
	 NUMACS MODELIST FASLOAD UNSFLST FXPDL REGPDL NLNVTHTBP 
	 #+ITS CCLOAD:CLOCK-SLOWDOWN  #+ITS CCLOAD:CLOCK-INTERVAL 
	 #+ITS CCLOAD:CLOCK-EPSILON  #+ITS CCLOAD:TIME-TEMP 
	 #+ITS CCLOAD:OTIME-TEMP 
	 CCLOAD:FLUSH-TTY CCLOAD:DEV-DIR  
	 )
	(SETQ RUNTIME (RUNTIME) TIME (TIME))
	(COMMENT 
		;SLOTX holds either NUMACS or REGACS, to hac the ALARMCLOCK
		;	(NUMACS) turns ALARMCLOCK feature on
		;	(REGACS) turns it off
		;RUNTIME is the RUNTIME before beginning
		;TIME is the realTIME before beginning
		;CCLOAD:CLOCK-INTERVAL is the interval between alarm rings, 
		;CCLOAD:CLOCK-EPSILON is the epsilonics - two tics within a 
		;    realtime of less than CCLOAD:CLOCK-EPSILON cause the 
		;    second to be ignored.
		;CCLOAD:CLOCK-SLOWDOWN is the time at which the interval should
		;     be slowed, [i.e., doubled] we want alarms less often as 
		;     time goes by 
		;CCLOAD:TIME-TEMP is a temporary time holder
		;CCLOAD:FLUSH-TTY causes a veto on message printers
	 )
	(SETQ ↑Q () )


;;; Falls thru to below
;

;;; Falls thru from above 

  #+ITS (COND ((STATUS FEATURE ITS)
	       (SETQ CCLOAD:CLOCK-EPSILON 3.0)
	       (SETQ NUMACS '(LAMBDA () 		;TURNS ALARM OFF
			      (ALARMCLOCK 'TIME -1)
			      (PRINC '|/
Clock-OFF | TYO)
			      (SETQ ALARMCLOCK () ↑W 'T CCLOAD:FLUSH-TTY 'T 
				    SLOTX REGACS))
		     REGACS '(LAMBDA () 		;TURNS ALARM ON
			      (SETQ ALARMCLOCK MODELIST ↑W () SLOTX NUMACS  
				    CCLOAD:FLUSH-TTY () CCLOAD:CLOCK-SLOWDOWN 40.0 
				    CCLOAD:CLOCK-INTERVAL 10.) 
			      (PRINC '|/
Clock-ON | TYO)
			      (ALARMCLOCK 'TIME 1.))
		     MODELIST '(LAMBDA (VGO) 
				(COND (CCLOAD:FLUSH-TTY (ALARMCLOCK 'TIME -1))
				      ('T (SETQ CCLOAD:TIME-TEMP (TIME))
					  (COND ((AND (NOT CCLOAD:FLUSH-TTY)
						      (> (-$ CCLOAD:TIME-TEMP 
							     CCLOAD:OTIME-TEMP) 
							 CCLOAD:CLOCK-EPSILON))
						 (TERPRI TYO)
						 (PRINC '|Using | TYO) 
						 (SETQ CCLOAD:TIME-TEMP 
						       (*QUO (- (RUNTIME) RUNTIME) 
							     1.0E5) )
						 (PRINC (*QUO (FIX CCLOAD:TIME-TEMP) 
							      10.0) 
							TYO)
						 (PRINC '| secs so far, out of | TYO)
						 (PRINC (*QUO (FIX (*$ (-$ (TIME) TIME) 10.0))
							      10.0) 
							TYO)
						 (PRINC '| |  TYO)
						 (SETQ CCLOAD:TIME-TEMP (TIME))))
					  (COND ((> (-$ (SETQ CCLOAD:OTIME-TEMP CCLOAD:TIME-TEMP) TIME)
						    CCLOAD:CLOCK-SLOWDOWN) 
						 (SETQ CCLOAD:CLOCK-SLOWDOWN 
						       (*$ 2.0 CCLOAD:CLOCK-SLOWDOWN) 
						       CCLOAD:CLOCK-INTERVAL 
						       (* 2 CCLOAD:CLOCK-INTERVAL))))
					  (ALARMCLOCK 'TIME CCLOAD:CLOCK-INTERVAL))) ))
		(SSTATUS TTYIN 30. '(LAMBDA (VGO VGOL) (FUNCALL SLOTX)))
		(FUNCALL REGACS)))						;Sets up SLOTX, and starts ALARMCLOCK

;;; Falls thru to below
;

;;; Falls thru from above 


    B	#+ITS (SETQ CCLOAD:OTIME-TEMP (TIME))
	(AND (NOT CCLOAD:FLUSH-TTY)
	     (PRINC '|/
  (In LISP version | TYO)
	     (PRINC (STATUS LISPV) TYO)
	     (PRINC '|)|) TYO)
  #+ITS	(OR (NOT (STATUS HACTR))
	    (VALRET (COND ((STATUS FEATURE XC)
			   '|↔≠/:JCL/
XCOMPL≠≠J:VP |)
			  ('|↔≠/:JCL/
COMPLR≠≠J:VP |))))
	(AND PURE (PAGEBPORG)) 
	(SETQ CCLOAD:DEV-DIR 
	       #+ITS '(DSK COMLAP) 
	       #+SAIL '(DSK (MAC LSP))
	       #-(or ITS SAIL) 
		  (COND #+DEC20 ((PROBEF '((PS MACLISP) COMPLR FASL))
				 '(PS MACLISP))
				((LIST 'DSK (STATUS UDIR)))))
      C (SETQ NLNVTHTBP (CONS CCLOAD:DEV-DIR '(* FASL)))
  #-ITS	(AND (NOT (PROBEF (CONS CCLOAD:DEV-DIR '(COMPLR FASL))))
	     (PROG2 (PRINC '|/
;Please set up "CCLOAD:DEV-DIR" to a list of the device and directory /
;names to use for the loading the COMPLR and FASLAP FASL files/
| TYO)
		    (BREAK ULUZ)
		    (GO C)))
	(COND ((NULL (GETSP (COND ((SIGNP L PURE) 12000.)
				  ('T  #+SAIL 50000. 
				       #-SAIL 43000.))))
	       (TERPRI)
	       (PRINC '|;Can't get enough Binary Program Space - You have lost badly!!|)
	       (TERPRI)
	       (BREAK ULUZ)
	       (GO C)))

;;; Falls thru to below
;

(comment LOAD ALL AUTOLOAD FILES)
;;; Falls thru from above 

	(SETQ 
	  LVRL 
	  '(LAMBDA (REGPDL)
	    (COND ((GET (CAR REGPDL) (CADR REGPDL))) 
		  ((OR (AND (SETQ GL (GET (CAR REGPDL) 'AUTOLOAD)) (PROBEF GL))
		       (PROBEF (SETQ GL (LIST '(LISP) (CADDR REGPDL) 'FASL)))
		       (AND (SETQ GL (MERGEF NLNVTHTBP (CADDR REGPDL)))
			    (PROBEF GL)))
		   (COND ((NOT CCLOAD:FLUSH-TTY) 
			  (TERPRI TYO)
			  (PRINC '|;Autoloading | TYO)
			  (PRINC (CADR GL) TYO) 
			  (PRINC '| | TYO)
			  (PRINC (CADDR GL) TYO)
			  (PRINC '| for | TYO)
			  (PRIN1 (CAR REGPDL) TYO)))
		   (LOAD GL))
		  ('T (PROG (↑Q ↑R ↑W)
			    (TERPRI)
			    (PRINC '/;)
			    (PRINC (CAR REGPDL))
			    (PRINC '| has not been defined.  Please load |)
			    (PRINC (CADDR REGPDL))
			    (PRINC '| file, and resume by <altmode>P |)
			    (BREAK WAIT-FOR-LOADING)) ))))

    #+SAIL (PROGN (HELP)
		  (FUNCALL LVRL '(GC-OVERFLOW-DAEMON SUBR DEMON))
		  (SETQ GC-OVERFLOW 'GC-OVERFLOW-DAEMON)
		  (DEFUN SAVE-COMPILER (GL)
			 (CDUMP (MAKNAM (APPEND (EXPLODEN '|SAVE |)
						(EXPLODEN GL))))))
    #-SAIL (FUNCALL LVRL '(GC-DAEMON SUBR GCDEMN))

	(MAPC LVRL '( (LET MACRO LET)
		      (DEFMACRO MACRO DEFMACRO) 
		      (GETMIDASOP SUBR GETMIDASOP)
		      (LDB MACRO LODBYT)
		      (+INTERNAL-SETF-X SUBR SETF) 
		      (DEFSETF MACRO DEFSETF)
		      (EVAL-ORDERED MACRO EVONCE)
		      (Y-OR-N-P LSUBR YESNOP)
		      (CERROR LSUBR CERROR)))

;;; Falls thru to below
;

(comment LOADING MAIN COMPLR FILES)
;;; Falls thru from above 

	(SETQ LVRL '(LAMBDA (REGPDL)
		     (SETQ GL (CONS CCLOAD:DEV-DIR 
				    (COND ((ATOM REGPDL) (CONS REGPDL '(FASL)))
					  (REGPDL))))
		     (COND ((PROBEF GL)
			    (COND ((NOT CCLOAD:FLUSH-TTY) 
				   (TERPRI TYO)
				   (PRINC '|	  Fazloading |)
				   (PRINC REGPDL TYO)
				   (PRINC '| FASL | TYO)))
			    (LOAD GL)
			    (COND ((AND (NOT CCLOAD:FLUSH-TTY) 
					(SETQ GL (COND ((EQ REGPDL 'FASLAP)
							'FASLVERNO) 
						       ((IMPLODE 
							 (NCONC 
							  (EXPLODEC REGPDL)
							  '(V E R N O))))))
					(BOUNDP GL)
					(SETQ GL (SYMEVAL GL)))
				   (TERPRI TYO)
				   (PRINC '|	       (|)
				   (PRINC REGPDL TYO)
				   (PRINC '| version number | TYO)
				   (PRINC GL TYO)
				   (PRINC '|) | TYO) )))
			   ('T (PROG (↑Q ↑R ↑W)
				 (TERPRI)
				 (PRINC '/;)
				 (PRINC REGPDL)
				 (PRINC '| FASL has not been found.  Please load it, and resume by <altmode>P |)
				 (BREAK ULUZ-BUNKIE))))))

	(MAPC LVRL '(COMPLR PHAS1 COMAUX FASLAP MAKLAP INITIA))

    #+SAIL (PROGN 
	       (PROG (PURE)
		(FUNCALL LVRL (COND ((AND (EQ GL 'DIRECT) (STATUS FEATURE DDT))
				     '(DIRECT DFA))
				    ('DIRECT))))
	       (MAPC LVRL '(EREAD MACROD NCOREQ LOADED))
	       (SETQ SAIL-MORE-SYSFUNS 
		     (APPEND '(EREAD EOPEN ELOAD UGREAT1 REQUIRE EDIT CODE 
				MACRODEF MACROBIND TRANS TRANSDEF MAIL %MATCH 
				%CONTINUE %CONTINUE-MATCH %CHAR1 %MATCH-LOOKUP 
				%%EXPAND%% %%EXPAND1%% %%%STRING%%% )
			     SAIL-MORE-SYSFUNS))
	       (MAPC '(LAMBDA (X) 
			(COND ((GET (CAR X) 'AUTOLOAD)
			       (AND (CDDR X) (ARGS (CAR X) (CDDR X)))
			       (AND (CDR X) (PUTPROP (CAR X) (CDR X) 'FUNTYP-INFO))))) 
		     '((EREAD FSUBR) (EOPEN LSUBR 0 . 4) (ELOAD SUBR () . 1)
			(UGREAT1 SUBR  () . 1) (REQUIRE FSUBR) (EDIT FSUBR) 
			(CODE FSUBR) (MAIL FSUBR))) )

;;; Falls thru to below
;

;;; Falls thru from above 

;;;; INITIALIZEing

  	(COND ((NOT CCLOAD:FLUSH-TTY) 
	       (TERPRI TYO)
	       (PRINC '|Initializing | TYO)))
	(AND |carcdrp/|| 
	     (MAPC '(LAMBDA (X) (|carcdrp/|| X)) 	;Make CARCDR props
		   '(CAR   CDR  CDDR  CDDDR  CDDDDR  	; exist for a few
		     CDAR CADR CADDR CADDDR))) 
	(INITIALIZE)
  #+ITS (ALARMCLOCK 'TIME -1)
  #-ITS (SSTATUS LINMO 'T)
	(COND ((NOT CCLOAD:FLUSH-TTY)
	       (TERPRI TYO)
	       (PRINC '|Total Time = | TYO)
	       (PRINC (*QUO (FIX (*QUO (- (RUNTIME) RUNTIME) 1.0E5)) 
			    10.0) 
		      TYO)
	       (PRINC '| secs out of | TYO)
	       (PRINC (*QUO (FIX (*$ (-$ (TIME) TIME) 10.0)) 10.0) TYO)
	       (TERPRI)))
         (SETQ ALARMCLOCK () ↑Q () ↑W () ))

;;; Note remainder of code below is outside this PROG
;;;

;;; Note that this code is still within the moby PROGN above

  (MAPC #'(LAMBDA (X) (REMPROP X 'MACRO)) CCLOAD:BOOTMACS)
  (AND (FILEP UREAD) (CLOSE UREAD))
  (INPUSH -1)			;Closes INIT file, if any, or else LOAD file
  (AND (STATUS SSTATUS FLUSH) (SSTATUS FLUSH 'T))
  (SETQ PUTPROP CCLOAD:PUTPROP)
  (MAPC 'REMOB 
	(MAPCAR 'MAKUNBOUND 
		'( #+ITS CCLOAD:CLOCK-SLOWDOWN #+ITS CCLOAD:CLOCK-INTERVAL 
		   #+ITS CCLOAD:CLOCK-EPSILON  #+ITS CCLOAD:TIME-TEMP 
		   #+ITS CCLOAD:OTIME-TEMP 
		   CCLOAD:DEV-DIR  CCLOAD:FLUSH-TTY CCLOAD:PUTPROP CCLOAD:BOOTMACS )))
  (GCTWA)
  (NORET () )
  #+ITS  (COND (PURE (PAGEBPORG) (PURIFY 0 0 'BPORG)))
  (SETQ PURE CCLOAD:PURE  *PURE () )
  (PRINC #+DEC20 '|Ready to SAVE as COMPLR.EXE.| 
	 #+DEC10 '|Ready to SSAVE as COMPLR.SAV (or .SHR,.LOW)/
Version number = |  
	 #+ITS (COND ((OR (NOT (FIXP PURE)) (STATUS FEATURE XC))
		      '|Dumping eXperimentalCOMPLr on LSPDMP;XC.DMP |)
		     ('T '|Dumping LSPDMP;CL.DMP |))
	 TYO)
  #+ITS (PROGN 
	 (SETQ CCLOAD:DUMPFILE 
	       (COND ((OR (NOT (FIXP CCLOAD:PURE)) (STATUS FEATURE XC))
		      '|DSK:LSPDMP;XC.DMP |)
		     ('|DSK:LSPDMP;CL.DMP |)))
	 (LET ((BASE 10.) (IBASE 10.) (*NOPOINT 'T))
	   (SETQ CCLOAD:DUMPVERNO 
		 (EXPLODEN (CADDR (PROBEF (MERGEF CCLOAD:DUMPFILE '|* >|)))))
	   (SETQ CCLOAD:DUMPVERNO  
		 (IMPLODE (EXPLODEN (1+ (READLIST CCLOAD:DUMPVERNO))))))
	 (PUTPROP 'COMPLR CCLOAD:DUMPVERNO 'VERSION)
	 (PRINC CCLOAD:DUMPVERNO TYO)
	 (TERPRI)
	 (CDUMP 0 (NAMESTRING 
		   (MERGEF CCLOAD:DUMPFILE (LIST '* CCLOAD:DUMPVERNO)))))
  #-ITS  (PROGN (MAKUNBOUND 'CCLOAD:PURE) 
		(PRINC COMPLRVERNO TYO)
		(TERPRI))
  #+SAIL  (COND (CCLOAD:PURESEG 
		 (MAKUNBOUND 'CCLOAD:PURESEG)
		 (CDUMP '|save sys:xcompl| 
			'(xcompl shr sys (1 3))))
		('T (MAKUNBOUND 'CCLOAD:PURESEG)
		    (CDUMP '|Save sys:xbcompl|)))
  #-(or ITS SAIL) 
     (PROGN (MAKUNBOUND 'CCLOAD:PURESEG)
	    (CDUMP))
)


ββββ